home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE12 / PARSER / SDD.PAS next >
Encoding:
Pascal/Delphi Source File  |  1996-07-25  |  3.0 KB  |  148 lines

  1. unit sdd; {string device driver to convert numbers and parse strings}
  2.  
  3. interface
  4.  
  5. uses SysUtils;
  6.  
  7. procedure AssignSt(var t:textFile;var s:string);
  8. procedure delim(var s:string;c:char;undo:boolean);
  9.  
  10. implementation
  11.  
  12. type
  13.   PString=^string;
  14.   usr=record
  15.     ps : PString;
  16.     ud : array[5..16] of byte;
  17.   end;
  18.  
  19. function InStr(var t:textFile):integer; far;
  20. begin
  21.   Result := 0; {for ioResult}
  22.   with TTextRec(t),usr(UserData) do
  23.   begin
  24.     if (BufPos<BufEnd) and (Handle<>0) then exit;
  25.     BufPos := 0;
  26.     BufEnd := length(ps^)-Handle;
  27.     if BufEnd>BufSize then BufEnd := BufSize;
  28.     move(ps^[succ(Handle)],BufPtr^,BufEnd);
  29.     inc(Handle,BufEnd);
  30.   end;
  31. end; {InStr}
  32.  
  33. function OutStr(var t:textFile):integer; far;
  34. var
  35.   i : integer;
  36. begin
  37.   with TTextRec(t),usr(UserData) do
  38.   begin
  39.     for i := BufEnd to BufPos-1 do ps^ := ps^+BufPtr^[i];
  40.     Handle := length(ps^);
  41.     BufEnd := BufPos;
  42.   end; {with}
  43.   Result := 0; {for ioResult}
  44. end; {OutStr}
  45.  
  46. function FlushStr(var t:textFile):integer; far;
  47. begin
  48.   Result := 0; {for ioResult}
  49. end; {FlushStr}
  50.  
  51. function CloseStr(var t:textFile):integer; far;
  52. begin
  53.   with TTextRec(t) do
  54.   begin
  55.     Mode := fmClosed;
  56.     Handle := 0;
  57.   end;
  58.   Result := 0; {for ioResult}
  59. end; {CloseStr}
  60.  
  61. function OpenStr(var t:textFile):integer; far;
  62. begin
  63.   with TTextRec(t),usr(UserData) do
  64.   begin
  65.     CloseFunc := @CloseStr;
  66.     case Mode of
  67.       fmInOut : begin
  68.         Mode := fmOutput;
  69.         InOutFunc := @OutStr;
  70.         FlushFunc := @OutStr;
  71.         Handle := length(ps^);
  72.       end;
  73.       fmInput : begin
  74.         InOutFunc := @InStr;
  75.         FlushFunc := @FlushStr;
  76.       end;
  77.       fmOutput : begin
  78.         InOutFunc := @OutStr;
  79.         FlushFunc := @OutStr;
  80.         ps^ := '';
  81.       end;
  82.     end; {case}
  83.   end; {with}
  84.   Result := 0; {for ioResult}
  85. end; {OpenStr}
  86.  
  87. procedure AssignSt(var t:textFile;var s:string);
  88. begin
  89.   with TTextRec(t),usr(UserData) do
  90.   begin
  91.     Mode := fmClosed;
  92.     BufSize := SizeOf(buffer);
  93.     BufPtr := @buffer;
  94.     OpenFunc := @OpenStr;
  95.     Name[0] := #0;
  96.     ps := @s;
  97.     Handle := 0;
  98.   end; {with}
  99. end; {AssignSt}
  100.  
  101. procedure delim(var s:string;c:char;undo:boolean); assembler;
  102. asm
  103.   {point to the string}
  104.   {with es:di and put its}
  105.   {length into cx}
  106.   les di,s
  107.   mov cl,es:di.0
  108.   {bail out if null string}
  109.   or cl,cl
  110.   jz @@2
  111.   xor ch,ch
  112.   {search direction forward}
  113.   cld
  114.   {make sure length byte not tested}
  115.   inc di
  116.  
  117.   {set up the comparison}
  118.   mov al,c
  119.   mov ah,13
  120.   mov bl,undo
  121.   or bl,bl
  122.   {leave normal if undo false}
  123.   {c will become #13}
  124.   jz @@1
  125.   {restore if undo}
  126.   {#13 will become c}
  127.   xchg al,ah
  128.  
  129.   @@1:
  130.   {search until match found}
  131.   repnz scasb
  132.   {if no match here then done}
  133.   {got here by reading end}
  134.   jnz @@2
  135.   {substitute the found char}
  136.   mov es:di.-1,ah
  137.   {check for found and at end}
  138.   {at the same time}
  139.   or cl,cl
  140.   jz @@2
  141.   {look for next match}
  142.   jmp @@1
  143.  
  144.   @@2:
  145. end;
  146.  
  147. end.
  148.